Cartographic Tour of R and {ggplot2}
Who am I?
- Analyst with ECOnorthwest
- Data visualization, housing & demographic analysis, mapping
- R maps featured in Upper Left Cities: A Cultural Atlas of San Francisco, Portland, and Seattle
Who am I?
- Analyst with ECOnorthwest
- Data visualization, housing & demographic analysis, mapping
- R maps featured in Upper Left Cities: A Cultural Atlas of San Francisco, Portland, and Seattle
How to make a good map
- Copy a good map
Jacques BertinWilliam BungeTimo Grossenbacher
How to make a good map
- Copy a good map
Jacques BertinWilliam BungeTimo Grossenbacher
How to make a good map
- Copy a good map
Jacques BertinWilliam BungeTimo Grossenbacher
Marginalia
📎 {ggspatial} can do so much, including easily add a north arrow and scale bar to your map
sea <- places("wa",
cb = TRUE) %>%
filter(NAME == "Seattle") %>%
st_transform(3857) %>%
erase_water(area_threshold = .25)
ggplot() +
geom_sf(data = sea) +
ggspatial::annotation_north_arrow(location = "br",
which_north = "true",
style = north_arrow_minimal) +
annotation_scale(location = "bl",
style = "ticks") +
coord_sf(crs = 3857,
datum = NA) +
theme_minimal() +
theme(panel.border = element_rect(linewidth = .2, fill = NA))
Marginalia, cont’d
📎 Giving your marginalia a little breathing room can be a good move. So expand your limits within coord_sf()!
sea <- places("wa",
cb = TRUE) %>%
filter(NAME == "Seattle") %>%
st_transform(3857) %>%
erase_water(area_threshold = .25)
xlims <- st_buffer(sea, 5000) %>%
st_bbox() %>%
.[c(1, 3)]
ylims <- st_buffer(sea, 5000) %>%
st_bbox() %>%
.[c(2, 4)]
ggplot() +
geom_sf(data = sea) +
ggspatial::annotation_north_arrow(location = "br",
which_north = "true",
style = north_arrow_minimal) +
annotation_scale(location = "bl",
style = "ticks") +
coord_sf(crs = 3857,
datum = NA,
xlim = xlims,
ylim = ylims) +
theme_minimal() +
theme(panel.border = element_rect(linewidth = .2, fill = NA))
Basemaps
📎 Kyle Walker’s {mapboxapi} + {ggspatial} = fast, easy basemaps to add context to your map
basemap <- get_static_tiles(
location = st_buffer(sea, 5000),
zoom = 10,
buffer_dist = 0,
scaling_factor = "2x",
crop = TRUE,
style_id = basic_id,
username = me
)
ggplot() +
layer_spatial(data = basemap) +
geom_sf(data = sea,
fill = NA,
color = "peru",
linewidth = 1.5) +
coord_sf(crs = 3857,
datum = NA,
xlim = xlims,
ylim = ylims) +
theme_minimal()
Basemaps, cont’d
📎 Try breaking your basemap into two layers: one for the labels and one for the map itself, using Mapbox studio (or other resource), and then layer them with multiple calls to layer_spatial()
tract_pop <- get_acs("tract",
state = "WA",
county = "King",
variables = "B01001_001",
geometry = TRUE) %>%
st_transform(st_crs(sea)) %>%
st_intersection(sea)
basemap <- get_static_tiles(
location = sea,
zoom = 11,
buffer_dist = 1000,
scaling_factor = "2x",
crop = TRUE,
style_id = basemap_id,
username = me
)
labels <- get_static_tiles(
location = sea,
zoom = 11,
buffer_dist = 1000,
scaling_factor = "2x",
crop = TRUE,
style_id = labels_id,
username = me
)
ggplot() +
layer_spatial(data = basemap) +
geom_sf(data = tract_pop,
aes(fill = estimate),
color = "gray20",
linewidth = .15,
alpha = .7) +
layer_spatial(data = labels) +
scale_fill_viridis_b(option = "A",
direction = 1,
name = "Population",
n.breaks = 7,
labels = comma) +
coord_sf(crs = 3857,
datum = NA) +
theme_minimal() +
theme(plot.background = element_rect(fill = "white", color = "gray20", linewidth = .2))
Legends
📎 Positioning your legend inside the map can be a good move, especially if you have a lot of white space you’d prefer not to deal with
ggplot() +
layer_spatial(data = basemap) +
geom_sf(data = tract_pop,
aes(fill = estimate),
color = "gray20",
linewidth = .15,
alpha = .7) +
layer_spatial(data = labels) +
scale_fill_viridis_b(option = "A",
direction = 1,
name = "Population",
n.breaks = 7,
labels = comma) +
coord_sf(crs = 3857,
datum = NA,
# This one is necessary!
expand = 0) +
theme_minimal() +
theme(legend.position = "inside",
legend.location = "plot",
legend.position.inside = c(0, 0),
legend.justification.inside = c(0, 0),
# element_rect() doesn't have an alpha argument, but you can trick it with HEX
legend.box.background = element_rect(fill = "#ffffff60", color = NA)) +
theme(plot.background = element_rect(fill = "white", color = "gray20", linewidth = .2))
Insets
📎 You can use {patchwork} to compose a simple inset map composition. Here you’re really just arranging two separate plots.
greenlake <- st_as_sfc("POLYGON ((-13620987 6050695, -13620987 6056227, -13615566 6056227, -13615566 6050695, -13620987 6050695))", crs = 3857) %>%
st_sf()
xlims <- st_bbox(greenlake)[c(1, 3)]
ylims <- st_bbox(greenlake)[c(2, 4)]
basemap <- get_static_tiles(
location = greenlake,
zoom = 13,
buffer_dist = 1000,
scaling_factor = "2x",
crop = TRUE,
style_id = basemap_id,
username = me
)
labels <- get_static_tiles(
location = greenlake,
zoom = 13,
buffer_dist = 1000,
scaling_factor = "2x",
crop = TRUE,
style_id = labels_id,
username = me
)
inset <- ggplot() +
geom_sf(data = sea,
fill = "white",
color = "gray20",
linewidth = .25) +
geom_sf(data = greenlake,
fill = NA,
color = "tomato",
linewidth = 1.25) +
theme_void() +
coord_sf(datum = NA) +
theme(plot.background = element_rect(fill = "#ffffff60", color = NA))
ggplot() +
layer_spatial(data = basemap) +
geom_sf(data = tract_pop,
aes(fill = estimate),
color = "gray20",
linewidth = .15,
alpha = .7) +
layer_spatial(data = labels) +
scale_fill_viridis_b(option = "A",
direction = 1,
name = "Population",
n.breaks = 7,
labels = comma) +
coord_sf(crs = 3857,
datum = NA,
# This one is necessary!
expand = 0,
xlim = xlims,
ylim = ylims) +
theme_minimal() +
theme(legend.position = "inside",
legend.location = "plot",
legend.position.inside = c(0, 0),
legend.justification.inside = c(0, 0),
# element_rect() doesn't have an alpha argument, but you can trick it with HEX
legend.box.background = element_rect(fill = "#ffffff60", color = NA)) +
patchwork::inset_element(inset,
left = .7,
bottom = 0,
right = 1,
top = .5,
align_to = "full")
Insets
📎 Or, {ggmagnify} could let you do a more traditional inset, if that’s what you’re looking for
counties <- counties("wa",
cb = TRUE) %>%
st_transform(3857)
to <- st_as_sfc("POLYGON ((-13881692 6185920, -13881692 6376113, -13774182 6376113, -13774182 6185920, -13881692 6185920))",
crs = 3857) %>%
st_sf()
xlims <- st_bbox(st_union(counties, to))[c(1, 3)]
ylims <- st_bbox(st_union(counties, to))[c(2, 4)]
county_map <- ggplot() +
geom_sf(data = counties,
fill = "white",
color = "gray40",
linewidth = .2) +
geom_sf(data = sea,
fill = NA,
color = "tomato",
linewidth = .2) +
coord_sf(crs = 3857,
datum = NA,
# This one is necessary!
expand = 0,
xlim = xlims,
ylim = ylims*c(.9, 1.1)) +
theme_minimal()
county_map +
geom_magnify(data = sea,
from = as.list(st_bbox(sea)[c(1, 3, 2, 4)]),
to = as.list(st_bbox(to)[c(1, 3, 2, 4)])) +
coord_sf(crs = 3857,
datum = NA,
# This one is necessary!
expand = 0,
xlim = xlims,
ylim = ylims*c(.99, 1.01))
Labels
📎 {ggrepel} is a very powerful tool for labeling your map, especially when you have a lot of labels to place. It can be a bit fussy though, so it will likely take lots of trial and error. And don’t sleep on the bg.colour argument for geom_text_repel()!
cities <- get_acs("place",
state = "wa",
variables = "B01001_001",
year = 2022,
geometry = TRUE) %>%
filter(estimate > 7.5e4) %>%
mutate(NAME = str_remove_all(NAME, paste0(c(" city, Washington", " CDP, Washington"), collapse = "|"))) %>%
mutate(class = santoku::chop(estimate, breaks = c(1e5, 1.5e5, 2e5))) %>%
# filter(NAME %in% c("Seattle", "Tacoma", "Olympia", "Spokane", "Walla Walla")) %>%
st_transform(3857)
ggplot() +
geom_sf(data = counties,
fill = "white",
color = "gray40",
linewidth = .2) +
geom_label_repel(data = st_centroid(cities),
aes(x = st_coordinates(geometry)[, 1],
y = st_coordinates(geometry)[, 2],
label = NAME,
size = class),
min.segment.length = 0,
color = "white",
fill = "tomato3",
label.r = unit(0, "lines"),
label.size = 0,
segment.colour = "tomato3",
segment.size = .5,
nudge_y = 50000) +
geom_sf(data = st_centroid(cities),
color = "tomato3",
fill = "white",
shape = 21,
stroke = 1) +
coord_sf(crs = 3857,
datum = NA,
# This one is necessary!
expand = 0) +
scale_size_discrete(range = c(6, 6, 8, 12),
guide = "none") +
theme_minimal() +
labs(x = NULL,
y = NULL)
Labels, cont’d
📎 Using st_inscribed_circle() can help you find the appropriate centroid for unusual polygons, especially when st_point_on_surface() fails
cities <- places("wa") %>%
filter(NAME %in% c("Seattle", "Tacoma", "Olympia", "Spokane", "Walla Walla")) %>%
st_transform(3857)
county_lbls <- st_point_on_surface(counties) %>%
transmute(name = NAME,
x = st_coordinates(.)[, 1],
y = st_coordinates(.)[, 2])
ggplot() +
geom_sf(data = counties,
fill = "white",
color = "gray40",
linewidth = .2) +
geom_text_repel(data = county_lbls,
aes(x = x,
y = y,
label = str_wrap(name, 10)),
# ggrepel functions have this bg.colour argument that is a nice touch for readability
bg.colour = "white",
bg.r = .2,
force = 0,
color = "gray70",
fontface = "bold",
size = 3.5) +
geom_label_repel(data = st_centroid(cities),
aes(x = st_coordinates(geometry)[, 1],
y = st_coordinates(geometry)[, 2],
label = NAME),
min.segment.length = 0,
color = "white",
fill = "tomato3",
label.r = unit(0, "lines"),
label.size = 0,
segment.colour = "tomato3",
segment.size = 1,
nudge_y = 50000) +
geom_sf(data = st_centroid(cities),
color = "tomato3",
fill = "white",
shape = 21,
stroke = 1) +
coord_sf(crs = 3857,
datum = NA,
expand = 0) +
theme_minimal() +
labs(x = NULL,
y = NULL)
Labels, cont’d
📎 Using st_inscribed_circle can help you find the appropriate centroid for unusual polygons, especially when st_point_on_surface fails
circles <- counties %>%
pull(geometry) %>%
st_inscribed_circle() %>%
st_sf() %>%
filter(!st_is_empty(geometry))
county_lbls <- circles %>%
st_centroid() %>%
transmute(name = counties$NAME,
x = st_coordinates(.)[, 1],
y = st_coordinates(.)[, 2])
ggplot() +
geom_sf(data = counties,
fill = "white",
color = "gray40",
linewidth = .2) +
geom_sf(data = circles,
fill = NA,
color = "gray20",
linewidth = .25,
linetype = "dotted") +
geom_text_repel(data = county_lbls,
aes(x = x,
y = y,
label = str_wrap(name, 10)),
# ggrepel functions have this bg.colour argument that is a nice touch for readability
bg.colour = "white",
bg.r = .2,
force = 0,
color = "gray70",
fontface = "bold",
size = 3.5) +
geom_label_repel(data = st_centroid(cities),
aes(x = st_coordinates(geometry)[, 1],
y = st_coordinates(geometry)[, 2],
label = NAME),
min.segment.length = 0,
color = "white",
fill = "tomato3",
label.r = unit(0, "lines"),
label.size = 0,
segment.colour = "tomato3",
segment.size = 1,
nudge_y = 50000) +
geom_sf(data = st_centroid(cities),
color = "tomato3",
fill = "white",
shape = 21,
stroke = 1) +
coord_sf(crs = 3857,
datum = NA,
expand = 0) +
theme_minimal() +
labs(x = NULL,
y = NULL)
Labels, cont’d
📎 {ggforce} has a geom_mark_...() family of functions that are nicely styled and can be used to label clusters of points or other geometries
# Read in the data, in this case this CSV from WA DNR https://data-wadnr.opendata.arcgis.com/datasets/dabefcb8f03549b49bee7564d4c3c4b5_2/
fires <- read_csv("/Users/sherrill/Projects/CascadiaR_Cartographic_Tips/01_data/01_raw/DNR_Fire_Statistics_2008_-_Present.csv") %>%
st_as_sf(coords = c("LON_COORD", "LAT_COORD"), crs = 4326) %>%
st_transform(3857) %>%
transmute(acres_burned = ACRES_BURNED,
cause = FIREGCAUSE_LABEL_NM,
year = str_sub(DSCVR_DT, 1, 4)) %>%
st_as_sf() %>%
filter(year == 2023,
acres_burned > 0)
fires_ne <- fires %>%
filter(year == 2023,
cause == "Power Gen") %>%
st_filter(counties %>%
filter(NAME %in% c("Pend Oreille", "Spokane", "Stevens"))) %>%
mutate(x = st_coordinates(geometry)[,1],
y = st_coordinates(geometry)[,2])
tot <- sum(fires_ne$acres_burned)
tot_2023 <- sum(fires$acres_burned)
pct <- tot/tot_2023
anchor <- st_centroid(st_union(fires_ne)) %>%
st_sf() %>%
mutate(x = st_coordinates(geometry)[,1],
y = st_coordinates(geometry)[,2])
ggplot() +
geom_sf(data = counties,
fill = "white",
color = "gray40",
linewidth = .2) +
geom_sf(data = fires,
aes(size = acres_burned),
color = "gray50",
alpha = .3) +
geom_sf(data = fires_ne,
aes(size = acres_burned),
color = "peru",
alpha = 1) +
geom_label_repel(data = st_centroid(cities),
aes(x = st_coordinates(geometry)[, 1],
y = st_coordinates(geometry)[, 2],
label = NAME),
min.segment.length = 0,
color = "white",
fill = "tomato3",
label.r = unit(0, "lines"),
label.size = 0,
segment.colour = "tomato3",
segment.size = 1,
nudge_y = 50000) +
geom_sf(data = st_centroid(cities),
color = "tomato3",
fill = "white",
shape = 21,
stroke = 1) +
geom_mark_ellipse(data = fires_ne,
aes(x = x,
y = y,
label = str_wrap(paste0("Wildfires caused by power generation burned a combined ", comma(tot, accuracy = 1), " acres, ", percent(pct, accuracy = 1), " of all statewide acres in 2023, in Pend Oreille, Spokane, and Stevens counties"), 36)),
x0 = anchor$x - 50000,
y0 = anchor$y + 50000,
label.fill = "#E4EBF1",
con.cap = 0,
label.buffer = unit(4, "lines"),
label.fontsize = 10,
show.legend = FALSE) +
scale_size_continuous(name = "Acres\nburned",
range = c(1, 10),
labels = comma,
breaks = c(10, 1000, 5000, 20000, 50000)) +
coord_sf(crs = 3857,
datum = NA,
expand = 0) +
theme_minimal() +
labs(x = NULL,
y = NULL)
Labels, cont’d
📎 {ggfx} has a number of graphical filtering functions. You could pair it with {ggforce} to create a poppy label box with a drop-shadow effect
all_fires <- read_csv("/Users/sherrill/Projects/CascadiaR_Cartographic_Tips/01_data/01_raw/DNR_Fire_Statistics_2008_-_Present.csv") %>%
st_as_sf(coords = c("LON_COORD", "LAT_COORD"), crs = 4326) %>%
st_transform(3857) %>%
transmute(acres_burned = ACRES_BURNED,
cause = FIREGCAUSE_LABEL_NM,
year = str_sub(DSCVR_DT, 1, 4)) %>%
st_as_sf()
fires <- all_fires %>%
filter(year == 2023,
acres_burned > 0)
fires_ne <- fires %>%
filter(year == 2023,
cause == "Power Gen") %>%
st_filter(counties %>%
filter(NAME %in% c("Pend Oreille", "Spokane", "Stevens"))) %>%
mutate(x = st_coordinates(geometry)[,1],
y = st_coordinates(geometry)[,2])
tot <- sum(fires_ne$acres_burned)
tot_2023 <- sum(fires$acres_burned)
pct <- tot/tot_2023
anchor <- st_centroid(st_union(fires_ne)) %>%
st_sf() %>%
mutate(x = st_coordinates(geometry)[,1],
y = st_coordinates(geometry)[,2])
ggplot() +
geom_sf(
data = counties,
fill = "white",
color = "gray40",
linewidth = .2
) +
geom_sf(
data = fires,
aes(size = acres_burned),
color = "gray50",
alpha = .3
) +
geom_sf(
data = fires_ne,
aes(size = acres_burned),
color = "peru",
alpha = 1
) +
geom_label_repel(
data = st_centroid(cities),
aes(
x = st_coordinates(geometry)[, 1],
y = st_coordinates(geometry)[, 2],
label = NAME
),
min.segment.length = 0,
color = "white",
fill = "tomato3",
label.r = unit(0, "lines"),
label.size = 0,
segment.colour = "tomato3",
segment.size = 1,
nudge_y = 50000
) +
geom_sf(
data = st_centroid(cities),
color = "tomato3",
fill = "white",
shape = 21,
stroke = 1
) +
with_shadow(
geom_mark_ellipse(
data = fires_ne,
aes(
x = x,
y = y,
label = str_wrap(
paste0(
"Wildfires caused by power generation burned a combined ",
comma(tot, accuracy = 1),
" acres, ",
percent(pct, accuracy = 1),
" of all statewide acres in 2023, in Pend Oreille, Spokane, and Stevens counties"
),
36
)
),
x0 = anchor$x - 50000,
y0 = anchor$y + 50000,
label.fill = "#E4EBF1",
con.cap = 0,
label.buffer = unit(4, "lines"),
label.fontsize = 10,
show.legend = FALSE
),
colour = "#151F2850",
sigma = 3
) +
scale_size_continuous(
name = "Acres\nburned",
range = c(1, 10),
labels = comma,
breaks = c(10, 1000, 5000, 20000, 50000)
) +
coord_sf(crs = 3857,
datum = NA,
expand = 0) +
theme_minimal() +
labs(x = NULL, y = NULL)
Patterns
📎 {ggdensity} has a geom_hdr() functions that provides a more visually appealing way to show point density, with a fairly easy-to-understand legend. You could even give it a blur with {ggfx} to make it seem more gestural than literal
fires_hdr <- fires %>%
mutate(x = st_coordinates(geometry)[,1],
y = st_coordinates(geometry)[,2]) %>%
st_drop_geometry() %>%
filter(cause %in% c("Natural", "Power Gen", "Fireworks")) %>%
mutate(cause = ordered(cause,
levels = c("Natural", "Power Gen", "Fireworks")))
ggplot() +
as_reference(with_blur(
geom_hdr(
data = fires_hdr,
aes(
x = x,
y = y,
group = cause,
fill = cause
),
probs = c(.33),
n = 300,
# Expand the limits to give the geometry some breathing room
xlim = st_bbox(counties)[c(1, 3)] * c(.9, 1.1),
ylim = st_bbox(counties)[c(2, 4)] * c(.9, 1.1),
alpha = .8
),
sigma = unit(.25, "lines")
), id = "hdr") +
# Putting a xor blend on our county borders could help them not get lost behind the HDR
with_blend(
geom_sf(
data = counties,
fill = "NA",
color = "gray20",
linewidth = .2
),
bg_layer = "hdr",
blend_type = "xor"
) +
geom_label_repel(
data = st_centroid(cities),
aes(
x = st_coordinates(geometry)[, 1],
y = st_coordinates(geometry)[, 2],
label = NAME
),
min.segment.length = 0,
color = "white",
fill = "tomato3",
label.r = unit(0, "lines"),
label.size = 0,
segment.colour = "tomato3",
segment.size = 1,
nudge_y = 50000
) +
geom_sf(
data = st_centroid(cities),
color = "tomato3",
fill = "white",
shape = 21,
stroke = 1
) +
scale_fill_manual(name = "Cause",
values = c("deepskyblue4", "deeppink4", "peru")) +
coord_sf(crs = 3857,
datum = NA,
expand = 0) +
theme_minimal(base_size = 12) +
theme(legend.position = "top",
legend.justification.top = "left") +
labs(x = NULL, y = NULL)
Patterns
📎 Then again, sometimes using a grid is an effective way of showing spatial patterns, and you can add an extra visual variable by using points that match your grid and varying their size
wa_grid <- st_make_grid(counties,
cellsize = 20000) %>%
st_sf() %>%
rowid_to_column("gridid")
fire_grid <- st_join(wa_grid, all_fires %>%
filter(acres_burned > 0,
cause %in% c("Power Gen", "Fireworks", "Natural"))) %>%
group_by(gridid, cause) %>%
summarise(acres_burned = sum(acres_burned)) %>%
group_by(gridid) %>%
filter(acres_burned == max(acres_burned, na.rm = TRUE)) %>%
ungroup() %>%
mutate(acres_burned = ifelse(is.na(acres_burned), 0, acres_burned)) %>%
st_centroid() %>%
mutate(cause = ordered(cause,
levels = c("Natural", "Power Gen", "Fireworks")))
ggplot() +
geom_sf(
data = counties,
fill = "white",
color = "gray40",
linewidth = .2
) +
geom_sf(data = fire_grid,
aes(color = cause, size = acres_burned),
shape = 15) +
geom_label_repel(
data = st_centroid(cities),
aes(
x = st_coordinates(geometry)[, 1],
y = st_coordinates(geometry)[, 2],
label = NAME
),
min.segment.length = 0,
color = "white",
fill = "tomato3",
label.r = unit(0, "lines"),
label.size = 0,
segment.colour = "tomato3",
segment.size = 1,
nudge_y = 50000
) +
geom_sf(
data = st_centroid(cities),
color = "tomato3",
fill = "white",
shape = 21,
stroke = 1
) +
scale_size_binned(
name = "Acres\nburned",
labels = comma,
range = c(2, 5),
breaks = c(10, 25000),
guide = guide_bins(keywidth = unit(2, "lines"))
) +
scale_color_manual(name = "Cause",
values = c("deepskyblue4", "deeppink4", "peru")) +
coord_sf(crs = 3857,
datum = NA,
expand = 0) +
theme_minimal(base_size = 12) +
theme(legend.position = "top",
legend.justification.top = "left") +
labs(
x = NULL,
y = NULL
)
Patterns
📎 Though you might want to make your other layers conform to this grid, too.
wa_grid <- st_make_grid(counties,
cellsize = 20000) %>%
st_sf() %>%
rowid_to_column("gridid")
county_grid <- wa_grid %>%
st_join(counties, largest = TRUE, left = FALSE) %>%
group_by(county = NAME) %>%
summarise()
county_grid_lbls <- county_grid %>%
pull(geometry) %>%
st_inscribed_circle() %>%
st_sf() %>%
filter(!st_is_empty(geometry)) %>%
st_centroid() %>%
transmute(name = county_grid$county,
x = st_coordinates(.)[, 1],
y = st_coordinates(.)[, 2])
fire_grid <- st_join(wa_grid, all_fires %>%
filter(acres_burned > 0,
cause %in% c("Power Gen", "Fireworks", "Natural"))) %>%
group_by(gridid, cause) %>%
summarise(acres_burned = sum(acres_burned)) %>%
group_by(gridid) %>%
filter(acres_burned == max(acres_burned, na.rm = TRUE)) %>%
ungroup() %>%
mutate(acres_burned = ifelse(is.na(acres_burned), 0, acres_burned)) %>%
st_centroid() %>%
mutate(cause = ordered(cause,
levels = c("Natural", "Power Gen", "Fireworks")))
ggplot() +
geom_sf(
data = county_grid,
fill = "white",
color = "gray40",
linewidth = .33
) +
geom_sf(data = fire_grid,
aes(color = cause,
size = acres_burned),
shape = 15) +
geom_label(data = county_lbls,
aes(x = x,
y = y,
label = str_wrap(name, 4)),
fill = "gray90",
alpha = .7,
color = "gray20",
fontface = "bold",
label.r = unit(0, "lines"),
label.size = 0,
size = 3.5) +
scale_size_binned(name = "Acres\nburned",
labels = comma,
range = c(2, 5),
breaks = c(10, 25000),
guide = guide_bins(keywidth = unit(2, "lines"))) +
scale_color_manual(name = "Cause",
values = c("deepskyblue4", "deeppink4", "peru")) +
coord_sf(crs = 3857,
datum = NA,
expand = 0) +
theme_minimal(base_size = 12) +
theme(legend.position = "top",
legend.justification.top = "left") +
labs(x = NULL, y = NULL)
Simplification
📎 While we’re modifying geometries, {rmapshaper} is a great package for simplifying geometries, which can be especially useful for rendering large spatial datasets
counties_simp <- ms_simplify(counties, keep = .02, keep_shapes = TRUE)
counties_simp_lbls <- counties_simp %>%
pull(geometry) %>%
st_inscribed_circle() %>%
st_sf() %>%
filter(!st_is_empty(geometry)) %>%
st_centroid() %>%
transmute(name = counties_simp$NAME,
x = st_coordinates(.)[, 1],
y = st_coordinates(.)[, 2])
ggplot() +
geom_sf(
data = counties_simp,
fill = "white",
color = "gray40",
linewidth = .2
) +
geom_sf(data = fire_grid,
aes(color = cause, size = acres_burned),
shape = 15) +
geom_label(
data = counties_simp_lbls,
aes(
x = x,
y = y,
label = str_wrap(name, 4)
),
fill = "gray90",
alpha = .7,
color = "gray20",
fontface = "bold",
label.r = unit(0, "lines"),
label.size = 0,
size = 3.5
) +
scale_size_binned(
name = "Acres\nburned",
labels = comma,
range = c(2, 5),
breaks = c(10, 25000),
guide = guide_bins(keywidth = unit(2, "lines"))
) +
scale_color_manual(name = "Cause",
values = c("deepskyblue4", "deeppink4", "peru")) +
coord_sf(crs = 3857,
datum = NA,
expand = 0) +
theme_minimal(base_size = 12) +
theme(legend.position = "top",
legend.justification.top = "left") +
labs(x = NULL, y = NULL)
Simplification
📎 {smoothr} can also be used to add rounded corners to your polygons or line geometries for a more stylized look
counties_simp <- counties %>%
ms_simplify(keep = .02, keep_shapes = TRUE) %>%
smooth(method = "ksmooth",
smoothness = .35) %>%
# Sometimes you can create geometry errors when smoothing, so it's good to check and fix these with a call to st_make_valid()
st_make_valid()
counties_simp_lbls <- counties_simp %>%
pull(geometry) %>%
st_inscribed_circle() %>%
st_sf() %>%
filter(!st_is_empty(geometry)) %>%
st_centroid() %>%
transmute(name = counties_simp$NAME,
x = st_coordinates(.)[, 1],
y = st_coordinates(.)[, 2])
ggplot() +
geom_sf(
data = counties_simp,
fill = "white",
color = "gray40",
linewidth = .2
) +
geom_sf(data = fire_grid,
aes(color = cause, size = acres_burned),
shape = 16) +
geom_label(
data = counties_simp_lbls,
aes(
x = x,
y = y,
label = str_wrap(name, 4)
),
fill = "gray90",
alpha = .7,
color = "gray20",
fontface = "bold",
label.r = unit(0, "lines"),
label.size = 0,
size = 3.5
) +
scale_size_binned(
name = "Acres\nburned",
labels = comma,
range = c(2, 5),
breaks = c(10, 25000),
guide = guide_bins(keywidth = unit(2, "lines"))
) +
scale_color_manual(name = "Cause",
values = c("deepskyblue4", "deeppink4", "peru")) +
coord_sf(crs = 3857,
datum = NA,
expand = 0) +
theme_minimal(base_size = 12) +
theme(legend.position = "top",
legend.justification.top = "left") +
labs(x = NULL, y = NULL)
Simplification
📎 Did you know you can use negative values for st_buffer()?
counties_simp <- counties %>%
st_buffer(-2000) %>%
ms_simplify(keep = .02, keep_shapes = TRUE) %>%
smooth(method = "ksmooth", smoothness = .35) %>%
# Sometimes you can create geometry errors when smoothing, so it's good to check and fix these with a call to st_make_valid()
st_make_valid()
counties_simp_lbls <- counties_simp %>%
pull(geometry) %>%
st_inscribed_circle() %>%
st_sf() %>%
filter(!st_is_empty(geometry)) %>%
st_centroid() %>%
transmute(name = counties_simp$NAME,
x = st_coordinates(.)[, 1],
y = st_coordinates(.)[, 2])
ggplot() +
geom_sf(
data = counties_simp,
fill = "white",
color = "gray20",
linewidth = .2
) +
geom_sf(
data = fire_grid %>%
st_filter(counties_simp),
aes(color = cause, size = acres_burned),
shape = 16
) +
geom_label(
data = counties_simp_lbls,
aes(
x = x,
y = y,
label = str_wrap(name, 4)
),
fill = "gray90",
alpha = .7,
color = "gray20",
fontface = "bold",
label.r = unit(0, "lines"),
label.size = 0,
size = 3.5
) +
scale_size_binned(
name = "Acres\nburned",
labels = comma,
range = c(2, 5),
breaks = c(10, 25000),
guide = guide_bins(keywidth = unit(2, "lines"))
) +
scale_color_manual(name = "Cause",
values = c("deepskyblue4", "deeppink4", "peru")) +
coord_sf(crs = 3857,
datum = NA,
expand = 0) +
theme_minimal(base_size = 12) +
theme(legend.position = "top",
legend.justification.top = "left") +
labs(x = NULL, y = NULL)
Symbols - Lines
📎 Brand new package {ggarrow} offers a completely new way of visualizing flowlines from point to point with arrows that aren’t the lackluster defaults from {ggplot2}. Lots of customizability!
lines <- st_as_sfc(c("LINESTRING (-122.3207 47.52453, -122.418 47.23233)", "LINESTRING (-122.3298 47.56603, -122.8504 47.03125)",
"LINESTRING (-122.2829 47.54782, -122.5151 45.6868)", "LINESTRING (-122.1708 47.5856, -117.4509 47.67072)",
"LINESTRING (-122.2388 47.55275, -119.3356 46.312)", "LINESTRING (-122.3922 45.71895, -119.4382 46.20556)",
"LINESTRING (-117.3921 47.49202, -119.2271 46.29595)"),
crs = 4326) %>%
st_transform(3857) %>%
st_sf() %>%
rowid_to_column("lineid") %>%
st_cast("POINT") %>%
mutate(x = st_coordinates(.)[,1],
y = st_coordinates(.)[,2]) %>%
st_drop_geometry() %>%
group_by(lineid) %>%
mutate(pt = 1:2) %>%
pivot_wider(names_from = pt,
values_from = c(x, y))
ggplot() +
geom_sf(
data = counties_simp,
fill = "white",
color = "gray40",
linewidth = .2
) +
geom_arrow_curve(
data = lines,
aes(
x = x_1,
y = y_1,
xend = x_2,
yend = y_2,
group = lineid
),
color = "deepskyblue4",
curvature = .2,
arrow_head = arrow_head_wings(offset = 50),
length = 2,
length_head = 1,
linewidth_head = 6,
linewidth_fins = 0,
alpha = .3
) +
scale_size_binned(
name = "Acres\nburned",
labels = comma,
range = c(2, 5),
breaks = c(10, 25000),
guide = guide_bins(keywidth = unit(2, "lines"))
) +
scale_color_manual(name = "Cause",
values = c("deepskyblue4", "deeppink4", "peru")) +
coord_sf(crs = 3857,
datum = NA,
expand = 0) +
theme_minimal(base_size = 12) +
theme(legend.position = "top",
legend.justification.top = "left") +
labs(x = NULL, y = NULL)
Symbols - Points
📎 {ggstar} doesn’t get enough love! It’s a great way to show point data with a little more flair than the standard {ggplot2} PCH shapes
star_fire_grid <- st_join(wa_grid, all_fires %>%
filter(acres_burned > 0,
year >= 2003,
cause %in% c("Power Gen", "Fireworks", "Natural"),
!is.na(cause)),
left = FALSE) %>%
st_drop_geometry() %>%
group_by(gridid, year, cause) %>%
summarise(acres_burned = sum(acres_burned)) %>%
ungroup() %>%
complete(year, cause, nesting(gridid), fill = list(acres_burned = 0)) %>%
filter(!is.na(cause)) %>%
group_by(gridid, cause) %>%
mutate(cause_acres = sum(acres_burned)) %>%
group_by(gridid) %>%
mutate(main_cause = first(cause[which(cause_acres == max(cause_acres))])) %>%
group_by(gridid, main_cause, year) %>%
summarise(acres_burned = ifelse(is.na(acres_burned), 0, acres_burned)) %>%
group_by(gridid, main_cause) %>%
summarise(year = weighted.mean(as.numeric(year), w = acres_burned, na.rm = TRUE),
acres_burned = sum(acres_burned)) %>%
ungroup() %>%
inner_join(wa_grid) %>%
st_as_sf() %>%
st_centroid() %>%
mutate(main_cause = ordered(main_cause,
levels = c("Natural", "Power Gen", "Fireworks")),
x = st_coordinates(.)[, 1],
y = st_coordinates(.)[, 2]) %>%
st_drop_geometry()
ggplot() +
geom_sf(
data = county_grid,
fill = "white",
color = "gray40",
linewidth = .2
) +
geom_star(
data = star_fire_grid,
aes(
fill = year,
size = acres_burned,
starshape = main_cause,
x = x,
y = y
),
starstroke = .1
) +
geom_label(
data = county_lbls,
aes(
x = x,
y = y,
label = str_wrap(name, 4)
),
fill = "gray90",
alpha = .7,
color = "gray20",
fontface = "bold",
label.r = unit(0, "lines"),
label.size = 0,
size = 3.5
) +
scale_size_binned(
name = "Acres\nburned",
labels = comma,
range = c(2, 5),
breaks = c(10, 25000),
guide = guide_bins(keywidth = unit(2, "lines"),
override.aes = list(starshape = 3))
) +
scale_starshape_manual(
name = "Cause",
values = c(
"Natural" = 28,
"Power Gen" = 30,
"Fireworks" = 3
),
guide = guide_legend(override.aes = list(size = 5))) +
scale_fill_distiller(name = "Wtd. Avg. Year",
palette = "Oranges",
direction = 1) +
coord_sf(crs = 3857,
datum = NA,
expand = 0) +
theme_minimal(base_size = 12) +
theme(legend.position = "right") +
labs(x = NULL, y = NULL)
Symbols - Points
📎 {ggsvg} give you the ability to use SVGs as points in your plots, even our old pal Clippy!
# Read in a downloaded static SVG
svg_text <- paste(readLines("./01_data/01_raw/clippy.svg"), collapse = "\n")
ggplot() +
geom_sf(
data = counties,
fill = "white",
color = "gray40",
linewidth = .2
) +
geom_point_svg(
data = clippy[1,],
aes(x = x, y = y),
size = 5,
svg = svg_text,
svg_width = 600,
svg_height = 800,
defaults = list(fill_inner = 'white', fill_outer = 'red')
) +
geom_label_repel(
data = clippy[1,],
aes(
x = x,
y = y,
label = str_wrap(lines, 24)
),
size = 5,
hjust = 0,
nudge_x = 50000,
nudge_y = 50000,
min.segment.length = 0,
point.padding = unit(2, "lines")
) +
scale_size_continuous(
name = "Acres\nburned",
range = c(1, 10),
labels = comma,
breaks = c(1, 5, 50, 100, 1000)
) +
coord_sf(crs = 3857,
datum = NA,
expand = 0) +
theme_minimal() +
labs(x = NULL, y = NULL)